home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-02
/
tsptp.zip
/
WHET.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1993-04-09
|
10KB
|
321 lines
(******************************************************************************)
(* WHET.PAS *)
(* For details, see Computer Journal article, 'A Synthetic Benchmark', *)
(* Jan 1976 pp43-49 Vol. 19 No. 1. Curnow & Wichman. *)
(******************************************************************************)
PROGRAM Whet(Output);
(******************************************************************************)
(* TIMING *)
(******************************************************************************)
(*$IFNDEF TopSpeed *)
(*%F TRUE *** Compile for Turbo Pascal ***)
USES TPBench;
(*%E*)
(*$ELSE *** Compile for TopSpeed Pascal ***)
IMPORT TSBench *;
(*$ENDIF *)
(******************************************************************************)
CONST
T1 = 0.499975;
T2 = 0.50025;
T3 = 2.0;
Wt = 10; (* corresponds to one million Whetstone instructions *)
TYPE
Rlarray = ARRAY[1..4] OF BmReal;
VAR
X, Y, Z: BmReal;
Xx:
RECORD
One, Two, Three, Four: BmReal
END;
E1: Rlarray;
I, Jj, Kk: BmInt;
N1, N2, N3, N4, N5, N6, N7, N8, N9, N10, N11: BmInt;
J, K, L: 1..4;
(*** This procedure should be commented out unless verifying the output ***
PROCEDURE Pout(N, J, K: BmInt; X1, X2, X3, X4: BmReal);
BEGIN
WriteCard(N, 0);
WriteCard(J, 0);
WriteCard(K, 0);
WriteString(' ');
WriteReal(X1, 15);
WriteString(' ');
WriteReal(X2, 15);
WriteString(' ');
WriteReal(X3, 15);
WriteString(' ');
WriteReal(X4, 15);
WriteLn
END Pout;
***)
PROCEDURE Proc1(VAR E:Rlarray);
VAR J: BmInt;
BEGIN
J := 0;
REPEAT
E[1] := ( E[1] + E[2] + E[3] - E[4]) * T1;
E[2] := ( E[1] + E[2] - E[3] + E[4]) * T1;
E[3] := ( E[1] - E[2] + E[3] + E[4]) * T1;
E[4] := (-E[1] + E[2] + E[3] + E[4]) / T3;
J := J + 1;
UNTIL J = 6
END;
PROCEDURE Proc2(X, Y: BmReal; VAR Z: BmReal);
BEGIN
X := T1 * (X + Y);
Y := T1 * (X + Y);
Z := (X + Y) / T3
END;
PROCEDURE Proc3;
BEGIN
E1[J] := E1[K];
E1[K] := E1[L];
E1[L] := E1[J]
END;
PROCEDURE Whetstone;
VAR I: BmInt;
BEGIN
(*** Module 1 - Convergence test using real numbers. ***)
(*** The execution of this loop was found to be statistically invalid, ***)
(*** but is included here for completeness. ***)
Xx.One := 1.0;
Xx.Two := -1.0;
Xx.Three := -1.0;
Xx.Four := -1.0;
FOR I := 1 TO N1 DO
BEGIN
Xx.One := ( Xx.One + Xx.Two + Xx.Three - Xx.Four) * T1;
Xx.Two := ( Xx.One + Xx.Two - Xx.Three + Xx.Four) * T1;
Xx.Three := ( Xx.One - Xx.Two + Xx.Three + Xx.Four) * T1;
Xx.Four := (-Xx.One + Xx.Two + Xx.Three + Xx.Four) * T1
END;
(* Pout(N1,N1,N1,Xx.One,Xx.Two,Xx.Three,Xx.Four); *)
(*** Module 2 - Convergence test using array elements. ***)
(*** Modules 2 & 3 use variations of the following transformation ***)
(*** statements: ***)
(*** ***)
(*** x1 = ( x1 + x2 + x3 - x4) * 0.5 ***)
(*** x2 = ( x1 + x2 - x3 + x4) * 0.5 ***)
(*** x3 = ( x1 - x2 + x3 + x4) * 0.5 ***)
(*** x4 = (-x1 + x2 + x3 + x4) * 0.5 ***)
(*** ***)
(*** Theoretically this set tends to the solution ***)
(*** ***)
(*** x1 = x2 = x3 = x4 = 1.0 ***)
(*** ***)
(*** The variables T1, T2, and T3 are terms designed to limit the ***)
(*** convergence of the set. ***)
E1[1] := 1.0;
E1[2] := -1.0;
E1[3] := -1.0;
E1[4] := -1.0;
FOR I := 1 TO N2 DO
BEGIN
E1[1] := ( E1[1] + E1[2] + E1[3] - E1[4]) * T1;
E1[2] := ( E1[1] + E1[2] - E1[3] + E1[4]) * T1;
E1[3] := ( E1[1] - E1[2] + E1[3] + E1[4]) * T1;
E1[4] := (-E1[1] + E1[2] + E1[3] + E1[4]) * T1
END;
(* Pout(N2,N3,N2,E1[1],E1[2],E1[3],E1[4]); *)
(*** Module 3 - Convergence test using procedure calls. ***)
FOR I := 1 TO N3 DO
Proc1(E1);
(* Pout(N3,N2,N2,E1[1],E1[2],E1[3],E1[4]); *)
(*** Module 4 - Conditional jumps. ***)
(*** Repeated iterations alternate the value of Jj between 0 and 1. ***)
Jj := 1;
FOR I := 1 TO N4 DO
BEGIN
IF Jj = 1 THEN
Jj := 2
ELSE
Jj := 3;
IF Jj > 2 THEN
Jj := 0
ELSE
Jj := 1;
IF Jj < 1 THEN
Jj := 1
ELSE
Jj := 0;
END;
(* Pout(N4,Jj,Jj,Xx.One,Xx.Two,Xx.Three,Xx.Four); *)
(*** Module 5 - Omitted. ***)
(*** Module 6 - Integer arithmetic and array addressing. ***)
(*** The values of integers J, K, and L remain unchanged through ***)
(*** iterations of the loop. ***)
J := 1;
K := 2;
L := 3;
FOR I := 1 TO N6 DO
BEGIN
J := J * (K - J) * (L - K);
K := L * K - (L - J) * K;
L := (L - K) * (K + J);
E1[L-1] := (J + K + L);
E1[K-1] := (J * K * L)
END;
(* Pout(N6,J,K,E1[1],E1[2],E1[3],E1[4]); *)
(*** Module 7 - Trigonometric functions. ***)
(*** The following loop almost transforms X and Y into themselves and ***)
(*** produces results that slowly vary. (The value of T1 ensures slow ***)
(*** convergence, as described above.) ***)
X := 0.5;
Y := 0.5;
FOR I := 1 TO N7 DO
BEGIN
X := T1 * arctan(T3 * sin(X) * cos(X) / (cos(X + Y) + cos(X - Y) - 1.0));
Y := T1 * arctan(T3 * sin(Y) * cos(Y) / (cos(X + Y) + cos(X - Y) - 1.0))
END;
(* Pout(N7,J,K,X,X,Y,Y); *)
(*** Module 8 - Procedure calls. ***)
(*** Values of X, Y, and Z are arbitrary. ***)
X := 1.0;
Y := 1.0;
Z := 1.0;
FOR I := 1 TO N8 DO
Proc2(X, Y, Z);
(* Pout(N8,J,K,X,Y,Z,Z); *)
(*** Module 9 - Array references and procedure calls. ***)
J := 1;
K := 2;
L := 3;
E1[1] := 1.0;
E1[2] := 2.0;
E1[3] := 3.0;
FOR I := 1 TO N9 DO
Proc3;
(* Pout(N9,J,K,E1[1],E1[2],E1[3],E1[4]); *)
(*** Module 10 - Simple integer arithmetic. ***)
(*** The execution of this loop was found to be statistically invalid, ***)
(*** but is included here for completeness. ***)
Jj := 2;
Kk := 3;
FOR I := 1 TO N10 DO
BEGIN
Jj := Jj + Kk;
Kk := Jj + Kk;
Jj := Kk - Jj;
Kk := Kk - Jj - Jj
END;
(* Pout(N10,Jj,Kk,Xx.One,Xx.Two,Xx.Three,Xx.Four); *)
(*** Module 11: Standard functions ***)
X := 0.75;
FOR I := 1 TO N11 DO
X := sqrt(exp(ln(X) / T2));
(* Pout(N11,Jj,Kk,X,X,X,X); *)
END;
BEGIN
WriteLn('Whetstone Benchmark');
(*** The variables N1-N11 are counters for Loops 2-11. Based on earlier ***)
(*** statistical work (Wichmann, 1970), loops 5 and 10 are omitted from the ***)
(*** test. The relative weights of modules 1 & 2 have been changed to ***)
(*** preserve the total yet exercise module 1. This is reasonable since ***)
(*** both modules should generate identical code. ***)
N1 := 2 * Wt; (* Set the values of the *)
N2 := 10 * Wt; (* Module weights. *)
N3 := 14 * Wt;
N4 := 345 * Wt;
N5 := 0;
N6 := 210 * Wt;
N7 := 32 * Wt;
N8 := 899 * Wt;
N9 := 616 * Wt;
N10 := 0;
N11 := 93 * Wt;
(******************************************************************************)
(* Compute the looping overhead. The Dummy procedure must have some side- *)
(* effect so that it is not optimised out of existence. *)
(******************************************************************************)
StartTimer; (* Start the clock. *)
REPEAT
Dummy;
UNTIL NullTimesUp;
(******************************************************************************)
(* Now run the benchmark. Note that the Dummy procedure is also called so *)
(* that we can eliminate its overhead from the looping overhead. *)
(******************************************************************************)
StartTimer; (* Start the clock. *)
REPEAT
Whetstone;
Dummy
UNTIL BenchTimesUp;
(******************************************************************************)
ReportTimes;
END.